\ Handles Mops user interface.

\ MOPS_OBJECTS sets up system objects for the Mops development environment.
\ We put it first so that we can tick the exported versions of some words,
\ which have to be referred to by vectors or x-arrays (since a module can
\ only be invoked through an exported word).

\ Note: the various things we do below in setting up fWind can't be done
\ by SysInit, since under System 7 fWind doesn't exist until a dictionary
\ is read in, which is later than SysInit time.  But for an installed
\ application which uses fWind, this module won't exist, so we have a
\ separate initialization word AppInit (in file ObjInit) which is called
\ by ObjInit for an installed application.  fWind will then be available
\ from the start, so AppInit does the setting up.


: MOPS_OBJECTS  { \ left top right bottom -- }
	classinit: fWind   markalive: fWind
	['] enFW  ['] disFW		setAct: fWind
	['] (about)  -> aboutVec
	myDoc title: fWind
	ScreenBits  -> bottom  -> right  -> top  -> left
	70 70 right bottom  true  setGrow: fWind
	setContRect: fWind  ;


	string	IMAGENAME			\ Current Mops dictionary image name
	string	APPL_NAME			\ Default appl name for Install
	string	APPL_VERS			\ Ditto version string
    0	value	APPL_SIG		\ Ditto signature

\ SAVEBASES marks certain modules as unloaded, but saves their base addresses, without actually unloading them.  RESTOREBASES restores the base  addresses the way they were.  We do this so a dictionary save can be done, yielding a valid dictionary image with the modules marked unloaded, but without our needing to reload these modules afterwards. We also do this when the "Purge Modules" menu item is chosen.  The modules we currently treat this way are this module (vital, or we'll crash), ExtrasMod, which remembers the current source file internally, and PathsMod, which remembers the current HFS paths. If you really want to purge everything, invoke PURGE directly, which will even purge this module, probably with entertaining results.  You have been warned.

: SAVEBASES	\ ( -- sundry_info )
	kludge: FEmod
	kludge: extrasmod
	kludge: pathsmod
	kludge: windowMod
	kludge: menuMod  ;

: RESTOREBASES	\ ( sundry_info -- )
	unkludge: menumod
	unkludge: windowmod
	unkludge: pathsmod
	unkludge: extrasmod
	unkludge: FEmod  ;



\		=========== Menu handlers ===========

: (ABOUT)		50 (tstr)  cr  ;


\		=============== File Menu ===============

    0	value	CURRVREF
false	value	SAVED?		\ True if dic image saved at least once
    0	value	SAVE_RC		\ I/O return code from dic save

: .SAVED
	type# 101 ( Saved: )  getname: ffcb  type  cr  ;

: SAVE		\ Takes name from input stream
	setname: ffcb
	saveBases  (save)  -> save_rc  restoreBases  \ Note: (save) does a purge
	save_rc  ?error 105  .saved  ;

: SAVEDIC
	get: imageName  name: fFcb  currVref  setVref: fFcb
	saveBases  (save) -> save_rc  restoreBases
	save_rc  ?error 105
	true -> saved?  .saved  ;

: STDSAVE		\ save via stdFile
	.cur
	" Save Dictionary As:"  saved? IF  get: imagename  ELSE  myDoc  THEN
	stdPut: fFcb
	IF
		getVref: fFcb  -> currVref
		getName: fFcb  put: imageName
		saveDic
		get: imageName  title: fWind
	THEN  ;

: DOSAVE		\ Resave current dictionary.
	saved?
	IF	saveDic
	ELSE	myDoc  put: imageName
		stdSave
	THEN  ;

: PRINT			\ Select and print a text file
	pushnew: loadFile
	'type TEXT 1 stdGet: topFile
	draw: fWind
	if  qPrint  then
	drop: loadfile ;

\		============= Edit Menu ===============

\ Scrap support

	string	PARMSTR
	var	THEOFFSET
	handle	SCRAPHDL

: GETSCRAP	\ ( -- len )
	0 0 put: parmStr  handle: parmStr  put: scrapHdl
	0  get: scrapHdl  'type TEXT  addr: theOffset
	call GetScrap
	setSize: parmStr  lock: parmStr  len: parmStr  ;

: SCRAPKEY	\ Gets next char from the scrap

	len: parmStr
	NIF  key!  unlock: FEmod  13  EXIT  THEN	\ Simulate a terminal CR
	1st: parmStr  1 skip: parmStr  ;

: MPASTE		\ Interprets from the scrap
	lock: FEmod
	getScrap 0<=  ?EXIT
	false -> relocChk?  ['] scrapKey -> key  true -> relocChk?
	sp0 sp!  quit  ;


\		============= Util Menu ===============


\ start the object list utility via its input dialog
: doOlist  3 beep ;
\	" List objects of class:" doInDlg
\	IF over +base over >uc objList  THEN ;

\ run the class lister
: doClist  3 beep  ;
\ .classes .ok ;

\ start the decompile utility via its input dialog
: doDe  3 beep  ;
\	" Enter word to decompile:" doDeDlg
\	IF  tib 128 erase  0 -> in
\		\ simulate terminal input from dialog text
\		tib swap cMove de' .ok
\	THEN ;

\ start the grep utility via its input dialog
: doGrep 3 beep  ;
\	" Enter string for search:" doGrDlg
\	IF (grep) .ok THEN ;


\		============ Mops Menu ==============

: CHKMOPS	\ ( item# b -- ) check item if boolean is true
	IF	check: mopsMen
	ELSE	unCheck: mopsMen
	THEN  ;

false	value	PRECHO?

: ?MOPSFLGS	1 echo? chkMops  0 prEcho? chkMops  ;

: PECHO		\ Toggles echo to printer
	prEcho? not -> prEcho?
	prEcho? IF  +print  ELSE  -print  drop: printmod  THEN
	?mopsFlgs  ;

: LECHO		\ Toggles echo during loads
	echo? not -> echo?  ?mopsFlgs  ;

: .ROOM
	cr
	." Room in dictionary:              "  room	7 .r  cr
	." Distance to top of hibase range: "  headroom	7 .r  cr
	." Total heap (no purge):           "  free	7 .r  cr
	." Largest block (purge):           "  freeblk	7 .r  cr  ;


: DOPURGE   saveBases  purge  restoreBases  ;

: DISFW
	0 disableitem: FileMen  1 disableitem: FileMen  2 disableitem: FileMen
	disable: UtilMen  disable: MopsMen
	false -> fWindActive?  ;

: ENFW
	0 enableitem: FileMen  1  enableitem: FileMen  2 enableitem: FileMen
	enable: UtilMen  enable: MopsMen
	true -> fWindActive?  ;


: NMENU
	lock: menuMod
	getnew: AppleMen  getnew: FileMen  getnew: EditMen
	getnew: UtilMen   getnew: MopsMen
	AppleMen FileMen EditMen UtilMen MopsMen  5  init: MenuBar
	?mopsFlgs  ;

\ The following words are called by Install to get and set the default name, version and signature for the current application.  They are initialized to the Mops values, but may be changed at any time.  Note that the first two of these words return a string object, rather than an addr and a length.  This was simpler for Install, and they shouldn't be getting called from anywhere else.

: GET_APPL_NAME		appl_name  ;
: GET_APPL_VERS		appl_vers  ;
: GET_APPL_SIG		appl_sig  ;

: SET_APPL_NAME		put: appl_name  ;
: SET_APPL_VERS		put: appl_vers  ;
: SET_APPL_SIG			-> appl_sig  ;

\ system startup word:

: RUN_FE
	keep: FEmod
	mops_objects  openMR  nMenu
	" mops.paths"  getPaths
	" Mops"		put: appl_name
	50 getString	put: appl_vers
	'type MOPS	-> appl_sig
	20 -> sleepticks
	select: fWind		\ Gets fWind onscreen under Stepping Out
	pause pause		\ gets it to front under MultiFinder
	cls  (about)  .room  ;

: (REL)
	release: imageName  ;

' (rel)  setrelease